home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
EnigmA Amiga Run 1998 July
/
EnigmA AMIGA RUN 29 (1998)(G.R. Edizioni)(IT)[!][issue 1998-07 & 08].iso
/
recent
/
fw_gfx.lha
/
FW_GfxClip
/
GfxClip.fwrexx.long
< prev
next >
Wrap
Text File
|
1998-06-14
|
13KB
|
414 lines
/* ================================ */
/* FINAL WRITER AREXX MACRO */
/* Graphics Clip Macro Generator. */
/* $VER: GfxMacroGen 3.1 (21.9.94) */
/* ================================ */
/* rewritten by: Heiko Schröder */
/* 4.1 (13.6.98) */
/* ================================ */
Options results
call addlib('rexxreqtools.library',5,-30)
Address='FinalW'
STATUS PORTNAME
FW = result
address = FW
SIGNAL ON BREAK_C
Call Open("sprache","env:language","R")
language=readln("sprache")
Call Close ("sprache")
/*Languages*/
If language="deutsch" then do
t0='"Gfx Clip 4.1 - Makro Generator" "© 1994 Softwood" "& 1998 Heiko Schröder" "Weiter" "Abbrechen" ""'
t1='"Keine Grafik ausgewählt." "Die Vorlage kann nicht erstellt werden." "" "Achso" "" ""'
t2="GFX Clip - Speichern unter"
t21="Speichern"
t3='"Sie haben keinen Dateinamen eingegeben." "Die Vorlage kann nicht erstellt werden." "" "Achso" "" ""'
t4='"Dateifehler!" "" "" "Oje" "" ""'
End
Else do
t0='"Gfx Clip 4.1 - Macro Generator" "© 1994 Softwood" "& 1998 Heiko Schröder" "Continue" "Cancel" ""'
t1 ='"No object selected." "The template could not be created." "" "Okay" "" ""'
t2="GFX Clip - Save As"
t21="Save"
t3 ='"You have not entered a valid filename." "The template could not be created." "" "Okay" "" ""'
t4 ='"File error!" "" "" "Oops" "" ""'
End
ShowMessage 1 1 t0
IF ( Result = 2 ) THEN EXIT
SetMeasure RULER
GetDocItemPrefs Decimal
Punkt=Result
If Punkt="Comma" then DocItemPrefs Decimal Period
Do While 1
/* Get a list of all the selected objects. */
i = 0
Object.0 = 0
objtype.0 = 0
FirstObject SELECTED
IF ( Result = 0 ) THEN DO
ShowMessage 1 1 t1
Call SEnd
END
DO WHILE ( Result ~= 0 )
i = i + 1
Object.i = Result
NextObject Object.i SELECTED
END
/* Ungroup groups */
gruppe = false
Do a = 1 to i
GetObjectType Object.a
objtype.a = Result
If objtype.a = 8 then do
SelectObject Object.a
gruppe = true
Ungroup
FirstObject SELECTED
DO WHILE ( Result ~= 0 )
i = i + 1
Object.i = Result
NextObject Object.i SELECTED
END
End
End
If gruppe = true then do
SelectObject Object.1
Do a = 2 to i
SelectObject Object.a MULTIPLE
End
End
else leave
End
/* Get a filename to use */
If GetClip("GFX-DIR")="" Then dir="FWMacros/"
Else dir=GetClip("GFX-DIR")
p=max(index(dir,':'),lastpos('/',dir))
file=delstr(dir,1,p)
dir=substr(dir,1,p)
filename = rtfilerequest(dir,file,t2,t21,"rt_screentofront=true" "rt_pubscrname=FinalWriterPubScreen")
/* Make sure a filename is entered */
if filename="" then DO
ShowMessage 1 1 t3
Call SEnd
END
void=SetClip("GFX-DIR",strip(filename,B,'"'))
/* Does the file already exist? */
IF EXISTS(filename) THEN DO
IF language="deutsch" then
t5 = '"Das Template <' || filename || '> existiert bereits." "Möchten Sie es überschreiben?" "" "Ja" "Nein" ""'
Else
t5 = '"The Template <' || filename || '> already exists." "Would you like to overwrite it?" "" "Yes" "No" ""'
ShowMessage 2 1 t5
IF ( Result = 2 ) THEN Call SEnd
END
/* What is the page height we are working with? */
GetPageSetup HEIGHT
pageHt = Result
/* Open the file. */
IF ( OPEN('GfxClipFile', filename, 'Write')~=1 ) THEN DO
/* File could not be opened. */
IF language="deutsch" then
t6 = '"Datei <' || filename || '> kann nicht geöffnet werden." "" "" "Oje" "" ""'
Else
t6 = '"File <' || filename || '> could not be opened." "" "" "Ok" "" ""'
ShowMessage 1 1 t6
Call SEnd
END
/* File is opened. */
/* Write the file header stuff */
CALL LineOut('GfxClipFile', '/* ------------------------ */')
CALL LineOut('GfxClipFile', '/* Final Writer Arexx Macro */')
CALL LineOut('GfxClipFile', '/* created on' date() ' */')
CALL LineOut('GfxClipFile', '/* with GfxClip 4.1 */')
CALL LineOut('GfxClipFile', '/* © Softwood / H. Schröder */')
CALL LineOut('GfxClipFile', '/* ------------------------ */')
CALL LineOut('GfxClipFile', '')
CALL LineOut('GfxClipFile', 'Options Results')
CALL LineOut('GfxClipFile', 'SetMeasure RULER')
CALL LineOut('GfxClipFile', 'GetDocItemPrefs Decimal')
CALL LineOut('GfxClipFile', 'Punkt=Result')
CALL LineOut('GfxClipFile', 'If Punkt="Comma" then DocItemPrefs Decimal Period')
CALL LineOut('GfxClipFile', 'Status PAGE')
CALL LineOut('GfxClipFile', 'page1=result+1')
CALL LineOut('GfxClipFile', 'GetSectionSetup FirstPage')
CALL LineOut('GfxClipFile', 'page2=result')
CALL LineOut('GfxClipFile', 'page=page1-page2')
CALL LineOut('GfxClipFile', 'numobjs = 0')
CALL LineOut('GfxClipFile', '')
/* ----------------------------------------------- */
/* For each object, determine the coordinates and */
/* find the minimum x and y values to use to */
/* normalize the coordinatess. */
/* ----------------------------------------------- */
x = 0
DO WHILE ( x < i )
x = x + 1
/* Before getting the coordinates un-rotate the object */
GetObjectRotation Object.x
objRotate.x = Result
IF ( objRotate.x ~= 0 ) THEN
SetObjectRotation Object.x 0
/* Get the coordinates */
GetObjectCoords Object.x
PARSE VAR Result page.x x1.x y1.x x2.x y2.x
/* If we un-rotated the object, rotate it back. */
IF ( objRotate.x ~= 0 ) THEN
SetObjectRotation Object.x objRotate.x
END
/* For each one of the graphic objects in our list */
/* create AREXX code to redraw the object. */
x = 0
DO WHILE ( x < i )
x = x + 1
SELECT
WHEN (objtype.x = 2 | objtype.x = 3) THEN DO
/* -------------- */
/* We have a Line */
/* -------------- */
modifier = ""
if ( objtype.x = 3 ) THEN
modifier = 'ARROW'
/* Output the commands to calculate line's position. */
commandLine = 'fromX =' x1.x ''
CALL LineOut('GfxClipFile', commandline)
commandLine = 'toX =' x2.x ''
CALL LineOut('GfxClipFile', commandline)
commandLine = 'fromY =' y1.x ''
CALL LineOut('GfxClipFile', commandline)
commandLine = 'toY =' y2.x ''
CALL LineOut('GfxClipFile', commandline)
/* Output the commands to draw the line. */
commandLine = 'DrawLine page fromX fromY toX toY' modifier
CALL LineOut('GfxClipFile', commandLine)
CALL LineOut('GfxClipFile', 'objectid.numobjs = Result')
CALL LineOut('GfxClipFile', 'numobjs = numobjs + 1');
/* Output the commands to set the line's parameters. */
GetObjectParams Object.x TEXTFLOW FLOWDIST LINEWT
PARSE VAR Result tf fd lw
commandLine = 'SetObjectParams 0' 'TEXTFLOW' tf 'FLOWDIST' fd 'LINEWT' lw
CALL LineOut('GfxClipFile', commandLine)
/* The line color may contain spaces, so treat it separately. */
GetObjectParams Object.x LINECOLOR
commandLine = 'SetObjectParams 0' 'LINECOLOR' "'" || '"' || Result || '"' || "'"
CALL LineOut('GfxClipFile', commandLine)
END
WHEN (objtype.x = 4 | objtype.x = 5) THEN DO
/* ------------- */
/* We have a Box */
/* ------------- */
modifier = ""
if (objtype.x = 5) THEN
modifier = 'BEVEL'
/* Output the command to draw the box. */
commandLine = 'newX =' x1.x ''
CALL LineOut('GfxClipFile', commandline)
commandLine = 'newY =' y1.x ''
CALL LineOut('GfxClipFile', commandline)
commandLine = 'DrawBox page newX newY' x2.x y2.x modifier
CALL LineOut('GfxClipFile', commandLine)
CALL LineOut('GfxClipFile', 'objectid.numobjs = Result');
CALL LineOut('GfxClipFile', 'numobjs = numobjs + 1');
/* Output the commands to set the box's parameters. */
GetObjectParams Object.x TEXTFLOW FLOWDIST LINEWT FILL
PARSE VAR Result tf fd lw fl
commandLine = 'SetObjectParams 0' 'TEXTFLOW' tf 'FLOWDIST' fd 'LINEWT' lw 'FILL' fl
CALL LineOut('GfxClipFile', commandLine)
/* The line and fill colors may contain spaces, so treat them separately. */
GetObjectParams Object.x LINECOLOR
commandLine = 'SetObjectParams 0' 'LINECOLOR' "'" || '"' || Result || '"' || "'"
CALL LineOut('GfxClipFile', commandLine)
GetObjectParams Object.x FILLCOLOR
commandLine = 'SetObjectParams 0' 'FILLCOLOR' "'" || '"' || Result || '"' || "'"
CALL LineOut('GfxClipFile', commandLine)
END
WHEN (objtype.x = 6 | objtype.x = 9) THEN DO
/* ------------------------- */
/* We have an Oval or an Arc */
/* ------------------------- */
modifier = ""
if (objtype.x = 9) THEN
modifier = 'ARC'
/* Output the command to draw the oval. */
commandLine = 'newX =' x1.x ''
CALL LineOut('GfxClipFile', commandline)
commandLine = 'newY =' y1.x ''
CALL LineOut('GfxClipFile', commandline)
commandLine = 'DrawOval page newX newY' x2.x y2.x modifier
CALL LineOut('GfxClipFile', commandLine)
CALL LineOut('GfxClipFile', 'objectid.numobjs = Result');
CALL LineOut('GfxClipFile', 'numobjs = numobjs + 1');
/* Output the commands to set the oval's parameters. */
GetObjectParams Object.x TEXTFLOW FLOWDIST LINEWT FILL
PARSE VAR Result tf fd lw fl
commandLine = 'SetObjectParams 0' 'TEXTFLOW' tf 'FLOWDIST' fd 'LINEWT' lw 'FILL' fl
CALL LineOut('GfxClipFile', commandLine)
/* The line and fill colors may contain spaces, so treat them separately. */
GetObjectParams Object.x LINECOLOR
commandLine = 'SetObjectParams 0' 'LINECOLOR' "'" || '"' || Result || '"' || "'"
CALL LineOut('GfxClipFile', commandLine)
GetObjectParams Object.x FILLCOLOR
commandLine = 'SetObjectParams 0' 'FILLCOLOR' "'" || '"' || Result || '"' || "'"
CALL LineOut('GfxClipFile', commandLine)
END
WHEN (objtype.x = 7) THEN DO
/* ------------------- */
/* We have a TextBlock */
/* ------------------- */
/* Output the command to draw the textblock. */
commandLine = 'newX =' x1.x ''
CALL LineOut('GfxClipFile', commandline)
commandLine = 'newY =' y1.x ''
CALL LineOut('GfxClipFile', commandline)
GetTextBlockText Object.x
text = Result
commandLine = 'DrawTextBlock page newX newY' '"' || text || '"'
CALL LineOut('GfxClipFile', commandLine)
CALL LineOut('GfxClipFile', 'objectid.numobjs = Result');
CALL LineOut('GfxClipFile', 'numobjs = numobjs + 1');
/* Output the commands to set the textblock's parameters. */
GetObjectParams Object.x TEXTFLOW FLOWDIST
PARSE VAR Result tf fd
commandLine = 'SetObjectParams 0' 'TEXTFLOW' tf 'FLOWDIST' fd
CALL LineOut('GfxClipFile', commandLine)
/* Output the commands to set the textblock's typespecs. */
GetObjectTypeSpecs Object.x SIZE LEADING WIDTH OBLIQUE
PARSE VAR Result sz ld wd ob
commandLine = 'SetObjectTypeSpecs 0' 'SIZE' sz 'LEADING' ld 'WIDTH' wd 'OBLIQUE' ob
CALL LineOut('GfxClipFile', commandLine)
/* The color and font may contain spaces, so treat them separately. */
GetObjectTypeSpecs Object.x COLOR
commandLine = 'SetObjectTypeSpecs 0' 'COLOR' "'" || '"' || Result || '"' || "'"
CALL LineOut('GfxClipFile', commandLine)
GetObjectTypeSpecs Object.x FONT
commandLine = 'SetObjectTypeSpecs 0' 'FONT' '"' || Result || '"'
CALL LineOut('GfxClipFile', commandLine)
END
OTHERWISE ITERATE /* Ignore images (objtype.x = 1), groups (objtype.x = 8),*/
/* draw class objects (objtype = 10) */
/* and anything else we don't recognize. */
END /* End select */
/* Output command to rotate the object if needed */
IF ( objRotate.x ~= 0 ) THEN DO
commandLine = 'SetObjectRotation 0' objRotate.x
CALL LineOut('GfxClipFile', commandLine)
END
/* Output the command to set the objects title. */
GetObjectTitle object.x
commandLine = 'SetObjectTitle 0' '"' || Result || '"'
CALL LineOut('GfxClipFile', commandLine)
/* Output a blank line */
CALL LineOut('GfxClipFile', '')
END /* End while */
/* Output commands to select all the new objects. */
CALL LineOut('GfxClipFile', 'i = 0')
CALL LineOut('GfxClipFile', 'DO WHILE (i < numobjs)')
CALL LineOut('GfxClipFile', 'SelectObject objectid.i MULTIPLE')
CALL LineOut('GfxClipFile', 'i = i + 1')
CALL LineOut('GfxClipFile', 'END')
CALL LineOut('GfxClipFile', '')
/* Output the command to redraw everything. */
CALL LineOut('GfxClipFile', 'Redraw')
CALL LineOUt('GfxClipFile', 'GraphicTool')
CALL LineOut('GfxClipFile', '')
CALL LineOut('GfxClipFile', 'If Punkt="Comma" then DocItemPrefs DECIMAL Comma')
/* Close the file */
CALL CLOSE('GfxClipFile');
/* Reselect all of our objects */
x = 0
DO WHILE ( x < i )
X = X + 1
SelectObject Object.x MULTIPLE
END
Call SEnd
/* ============================================ */
/* LineOut */
/* Procedure to write a line out to the file */
/* checking for errors and exiting if any found */
/* ============================================ */
LineOut: PROCEDURE
PARSE ARG filehandle, str
len = WRITELN( filehandle, str )
IF (len ~= LENGTH(str) + 1) THEN DO
ShowMessage 1 1 t4
CALL CLOSE(filehandle);
EXIT
END
RETURN
SEnd:
If Punkt="Comma" then DocItemPrefs DECIMAL Comma
Exit
RETURN